home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / write_srf.pro < prev    next >
Text File  |  1997-07-08  |  6KB  |  208 lines
  1. ; $Id: write_srf.pro,v 1.4 1997/01/15 03:11:50 ali Exp $
  2. ;
  3. ; Copyright (c) 1988-1997, Research Systems, Inc.  All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5.  
  6. PRO WRITE_SRF, FILE, IMG, R, G, B, WRITE_32 = write_32, ORDER = ORDER
  7. ;+
  8. ; NAME:
  9. ;    WRITE_SRF
  10. ;
  11. ; PURPOSE:
  12. ;    Write an IDL image and color table vectors to a
  13. ;    Sun rasterfile.
  14. ;
  15. ; CATEGORY:
  16. ;
  17. ; CALLING SEQUENCE:
  18. ;    WRITE_SRF, File        ;Write contents of current window. 
  19. ;
  20. ;    WRITE_SRF, File, Image  ;Write a given array.
  21. ;
  22. ;    WRITE_SRF, File, Image, R, G, B  ;Write array with given color tables.
  23. ;
  24. ; INPUTS:
  25. ;    File:    Scalar string giving the name of the rasterfile to write.
  26. ;
  27. ;    Image:    The 2D array to be output.  If Image is dimensioned (3,n,m),
  28. ;        a 24-bit Sun Raster File is written.  If Image is omitted,
  29. ;        the entire current window is read into an array and written
  30. ;        to the SRF file.  IMAGE should be of byte type, and in top
  31. ;        to bottom scan line order.
  32. ;
  33. ; OPTIONAL INPUT PARAMETERS:
  34. ;      R, G, B:    The Red, Green, and Blue color vectors to be written
  35. ;        with Image.
  36. ;
  37. ; KEYWORD PARAMETERS:
  38. ;    ORDER:    If specified, the image is written from the top down instead
  39. ;        of bottom up.  This only has effect
  40. ;        when writing a file from the current IDL window instead of 
  41. ;        an image passed as a parameter.
  42. ;
  43. ;     WRITE_32:    If the input image is a true color image, dimensioned (3,n,m), 
  44. ;        it is normally written as a 24-bit raster file.  Set this 
  45. ;        keyword to write the result as a 32-bit file.
  46. ;
  47. ; OUTPUTS:
  48. ;    FILE contains the image in rasterfile format. If color vectors
  49. ;    were supplied, they are used. Otherwise, the last color tables
  50. ;    established by LOADCT are used (If LOADCT hasn't been used
  51. ;    to establish color tables yet it is used to load the B/W tables.).
  52. ;
  53. ;    See the file /usr/include/rasterfile.h for the structure of
  54. ;    Sun rasterfiles.
  55. ;
  56. ; COMMON BLOCKS:
  57. ;    COLORS
  58. ;
  59. ; SIDE EFFECTS:
  60. ;    If R, G, and B aren't supplied and LOADCT hasn't been called yet,
  61. ;    this routine uses LOADCT to load the B/W tables.
  62. ;
  63. ; RESTRICTIONS:
  64. ;    This routine only writes 32, 24, & 8-bit deep rasterfiles of
  65. ;    type RT_STANDARD.  Use the Unix command rasfilter8to1(1) to convert 
  66. ;    these files to 1-bit deep files.
  67. ;
  68. ; MODIFICATION HISTORY:
  69. ;    Written 26 June 1988, AB.
  70. ;
  71. ;    Added 24 bit color, March 1990, DMS.
  72. ;
  73. ;    Added 32 bit color, July, 1990, DMS.
  74. ;
  75. ;    Changed to use CURRENT, rather than ORIGINAL colortables, if
  76. ;    the color parameter is not provided.  Made sure
  77. ;    that colortables were written as bytes.  April, 1991.
  78. ;        
  79. ;    Fixed bug that misordered the colors when writing a 24 bit
  80. ;    image.  Jan, 1992.
  81. ;
  82. ;    Fixed bug that had the colors for 24 bit images misordered.
  83. ;    The colors were being written as RGB, bug for a standard
  84. ;    type of SRF the colors should be in BGR order. This is as
  85. ;    per the Ency. of Graphic file formats. Also verfied
  86. ;    this with other SRF reading programs. May 7th,1996 kdb.
  87. ;
  88. ;    Fixed bug that occurred when byte padding was performed on
  89. ;    an odd columned image. The values in the file header didn't
  90. ;    reflect this addition of one column to the file. May 7th, 1996 kdb.
  91. ;-
  92. ; Copyright (c) 1990, Research Systems, Inc.  All rights reserved.
  93. ;    Unauthorized reproduction prohibited.
  94. ;
  95. common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
  96.  
  97. ; Check the arguments
  98. on_error, 1        ;Return to main level if error
  99. n_params = n_params();
  100.  
  101. if n_params eq 1 then begin
  102.     n_params = 2        ;Fake 2 param call
  103.     if n_elements(order) ne 1 then order = 1  ;Set default
  104.     img = tvrd(0,0,!d.x_vsize, !d.y_vsize, ORDER = order)
  105.     endif
  106.  
  107. IF ((n_params NE 2) AND (n_params NE 5))THEN $
  108.   message, "usage: WRITE_SRF, image, [r, g, b]'
  109.  
  110. ; Does image have the required attributes?
  111. img_size = SIZE(img)
  112. IF (img_size[0] NE 2) and (img_size[0] ne 3) THEN  $
  113.     message, 'Image must be a matrix.'
  114.  
  115. if (img_size[0] eq 3) and (img_size[1] ne 3) then $
  116.     message, '24 or 32 Bit images must be dimensioned (3,n,m)'
  117.  
  118.  
  119. if img_size[0] eq 3 then begin
  120.     if keyword_set(write_32) then depth = 32L else depth = 24L
  121.     istart = 1
  122.     cols = img_size[2]
  123.     rows = img_size[3]
  124.   endif else begin
  125.     depth = 8L
  126.     istart = 0
  127.     cols = img_size[1]
  128.     rows = img_size[2]
  129.  endelse
  130.  
  131. ; If any color vectors are supplied, do they have right attributes ?
  132. IF (n_params EQ 5) THEN BEGIN
  133.     r_size = SIZE(r)
  134.     g_size = SIZE(g)
  135.     b_size = SIZE(b)
  136.     IF ((r_size[0] + g_size[0] + b_size[0]) NE 3) THEN $
  137.         message, "R, G, & B must all be 1D vectors."
  138.     IF ((r_size[1] NE g_size[1]) OR (r_size[1] NE b_size[1]) ) THEN $
  139.         message, "R, G, & B must all have the same length."
  140.     map_len = r_size[1] * 3L
  141.     ENDIF ELSE BEGIN
  142.     IF (n_elements(r_curr) EQ 0) THEN LOADCT, 0    ; Load B/W tables
  143.     map_len = n_elements(r_curr) * 3
  144.     ENDELSE
  145.  
  146. ; Write the result
  147. OPENW, unit, file, /STREAM, /GET_LUN
  148. a =  { rasterfile, $        ;Make the header
  149.     magic:'59a66a95'XL, $
  150.     width: cols, $
  151.     height: rows, $
  152.     depth: depth, $
  153.     length: rows * cols, $
  154.     type:1L, $
  155.     maptype: 1L, $
  156.     maplength: map_len}
  157.  
  158. test = byte(1L,0,4)  ;Get the byte order of this machine
  159.  
  160. if test[0] eq 1b then begin  ;I386 order?
  161.     byteorder, a, /htonl        ;To network order
  162.     endif
  163.  
  164. ; Bug fix: Make sure that if column padding is reflected in the header.
  165. ; This only applies to < 32 bit images.
  166. if( (cols and 1) ne 0 and (depth ne 32))then begin
  167.      a.width = a.width+1;
  168.      a.length = a.length + a.height
  169. endif
  170.     
  171. WRITEU, unit,a                ;Write header
  172. IF (n_params EQ 5) THEN BEGIN
  173.     WRITEU, unit, BYTE(r)        ;Write out color tables
  174.     WRITEU, unit, BYTE(g)
  175.     WRITEU, unit, BYTE(b)
  176.     ENDIF ELSE WRITEU, unit, BYTE(r_curr), BYTE(g_curr), BYTE(b_curr)
  177.  
  178. if depth eq 32 then begin        ;Pad out 24 to 32 bits
  179.     for i=0, rows-1 do $
  180.         writeu, unit, byte(img[[2,2,1,0],*,i]) ; 3 bytes/pixel to 4
  181.     FREE_LUN, unit
  182.     return
  183. endif
  184.  
  185. if (cols and 1) ne 0 then begin ;Odd number of columns?
  186.     message, 'Warning, image width should be even, adding padding.',/info
  187.     if depth eq 8 then $
  188.         for i=0,rows-1 do $  ;Each row
  189.            writeu, unit, byte(img[*,i]), 0b $
  190.     else for i=0, rows-1 do $ 
  191.     ; Bug Fix. FOR A 24 Bit image. A standard SRF stores colors in a 
  192.     ; BGR format, not a RGB format!
  193.         writeu, unit, byte(img[[2,1,0],*,i]), [0b,0b,0b] 
  194. endif else begin
  195.     if( depth eq 8)then $
  196.           WRITEU, unit, BYTE(img) $
  197.     else begin 
  198.     ; Bug Fix. for a 24 big image, the color vectors need to be
  199.     ; stored in a BGR format. 
  200.       for i=0, rows-1 do $
  201.          writeu, unit, byte(img[[2,1,0],*,i]) 
  202.     end
  203. endelse
  204.  
  205. FREE_LUN, unit            ; Close file and free unit
  206.  
  207. end
  208.